home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / graphics / 3dvect37.zip / STONE.ZIP / STONE.BAS < prev   
BASIC Source File  |  1994-06-12  |  4KB  |  207 lines
  1. CLS
  2. RANDOMIZE
  3. DIM a(1000), b(1000)
  4. DIM hh(1000)
  5.  
  6. newparams:
  7. SCREEN 0
  8. WIDTH 80, 50
  9. CLS
  10.  
  11. INPUT " Start Pel              : "; qaa
  12. INPUT " Range       default 16 : "; qqb
  13. IF d$ = "" THEN INPUT " Palette     def pal.pal: "; d$
  14.  
  15. INPUT " Length of table def 500:"; ggh
  16. INPUT " Y Variance      def 100:"; yvar
  17. INPUT " Width           def 320:"; wd
  18.  
  19. INPUT " Dump file name (no extension!):"; c$
  20. INPUT " Dump starting character:"; h$
  21.  
  22. IF wd = 0 THEN wd = 320
  23. IF yvar = 0 THEN yvar = 100
  24.  
  25. IF ggh = 0 THEN ggh = 500
  26. IF yvar = 0 THEN yvar = 100
  27.  
  28. IF qqb < 2 THEN qqb = 16
  29. IF d$ = "" THEN d$ = "pal.pal"
  30.  
  31. SCREEN 13: DEF SEG = &HA000
  32.  
  33. GOSUB getpal
  34.  
  35. again:
  36. a(0) = RND(1) * qqb + qaa
  37. FOR x = 1 TO ggh
  38. kkkjj:
  39.  a(x) = INT(RND(1) * qqb + qaa)
  40.  b(x) = a(x)
  41.  IF ABS(a(x) - a(x - 1)) <= 0 THEN GOTO kkkjj
  42. NEXT x
  43.  
  44. g = 0
  45. h = 0
  46. i = 0
  47. j = 0
  48. k = 0
  49. q = 0
  50.  
  51. FOR x = 1 TO wd
  52. eerr:
  53.  q = q + 1
  54.  n = RND(1) * (yvar - 5)
  55.  IF ABS(g - n) < yvar / 3 THEN GOTO eerr
  56.  IF q > 5 THEN GOTO oks
  57.  IF ABS(h - n) < yvar / 6 THEN GOTO eerr
  58.  IF ABS(i - n) < yvar / 8 THEN GOTO eerr
  59.  IF ABS(j - n) < yvar / 10 THEN GOTO eerr
  60.  IF ABS(k - n) < yvar / 10 THEN GOTO eerr
  61. oks:
  62.  k = j
  63.  j = i
  64.  i = h
  65.  h = g
  66.  g = n
  67.  hh(x) = INT(n)
  68.  
  69. NEXT x
  70.  
  71. intensity = 256: ' used for darken
  72. level = 0
  73.  
  74. redraw:
  75.  
  76. hhj = wd
  77. 'IF hhj > 320 THEN hhj = 320
  78.  
  79. FOR x = 0 TO hhj - 1
  80.  FOR y = 0 TO 200
  81.   h = x + y * 320&
  82.   q = hh(x + 1) + y + level
  83.   POKE h, a(q + 1)
  84.  NEXT y
  85. oop:
  86. x$ = INKEY$
  87. IF x$ <> "" THEN GOTO aborted
  88. NEXT x
  89.  
  90. LOCATE 1, 1
  91. FOR z = 1 TO 20 * RND(1): PRINT "": NEXT z
  92. PRINT "s=save, space=recycle, q=quit"
  93. PRINT "r=redraw,d=color down, u=color up"
  94. PRINT "[=view bottom,]= view top"
  95.  
  96. llkk:
  97. DO
  98. x$ = INKEY$
  99. LOOP WHILE x$ = ""
  100. aborted:
  101. IF x$ = " " THEN GOTO again
  102. IF x$ = "r" THEN GOTO redraw
  103. IF x$ = "d" THEN GOTO darken
  104. IF x$ = "u" THEN GOTO light
  105. IF x$ = "a" THEN GOTO newparams
  106. IF x$ = "q" THEN END
  107. IF x$ = "s" THEN GOTO filesave
  108. IF x$ = "[" THEN GOTO light3
  109. IF x$ = "]" THEN GOTO light4
  110.  
  111. GOTO llkk
  112.  
  113. light3:
  114.  level = 200
  115.  GOTO redraw
  116. light4:
  117.  level = 0
  118.  GOTO redraw
  119.  
  120. darken:
  121.  intensity = intensity - 3
  122.  IF intensity <= 0 THEN intensity = 256
  123.  GOTO kkll2
  124. light:
  125.  intensity = intensity + 3
  126.  IF intensity >= 256 THEN intensity = 0
  127. kkll2:
  128.  FOR z = 0 TO ggh
  129.   a(z) = INT((b(z) - qaa) / 256 * intensity + qaa)
  130.  NEXT z
  131. GOTO redraw
  132.   
  133. filesave:
  134. SCREEN 0
  135. WIDTH 80, 50
  136.  
  137. q$ = c$ + h$ + ".inc"
  138.  
  139. OPEN q$ FOR OUTPUT AS #1
  140.  
  141.  PRINT #1, "header"; h$; " dd offset stonel"; h$; " - offset $"
  142.  PRINT #1, "        dd offset stoney"; h$; " - offset $"
  143.  PRINT #1, ""
  144.  PRINT #1, "stonel"; h$; " db ";
  145.  
  146.   z = 1
  147.   FOR c = 1 TO ggh
  148.    PRINT #1, LTRIM$(RTRIM$(STR$(a(c))));
  149.    z = z + 1
  150.    IF z = 17 AND c <> ggh THEN z = 1: PRINT #1, "": PRINT #1, "        db "; : GOTO hhggff
  151.    IF c <> ggh THEN PRINT #1, ",";
  152. hhggff:
  153.   NEXT c
  154.  
  155.  PRINT #1, ""
  156.  PRINT #1, ""
  157.  PRINT #1, "stoney"; h$; " db ";
  158.  
  159.  c = ASC(h$)
  160.  c = c + 1
  161.  IF c = 58 THEN c = 97
  162.  h$ = CHR$(c)
  163.  
  164.   z = 1
  165.   FOR c = 1 TO wd
  166.    PRINT #1, LTRIM$(RTRIM$(STR$(hh(c))));
  167.    z = z + 1
  168.    IF z = 17 AND c <> wd THEN z = 1: PRINT #1, "": PRINT #1, "        db "; : GOTO hhggff2
  169.    IF c <> wd THEN PRINT #1, ",";
  170. hhggff2:
  171.   NEXT c
  172.  
  173. PRINT #1, ""
  174. PRINT #1, ""
  175. CLOSE #1
  176.  
  177. PRINT " File saved as:"; q$
  178. PRINT ""
  179. PRINT " n = new parameters"
  180. PRINT " c = continue with old"
  181. PRINT " q = quit"
  182.  
  183. llkkf:
  184. DO
  185. x$ = INKEY$
  186. LOOP WHILE x$ = ""
  187.  
  188. IF x$ = "n" THEN GOTO newparams
  189. IF x$ = "c" THEN SCREEN 13: GOSUB getpal: GOTO redraw
  190. IF x$ = "q" THEN END
  191. GOTO llkkf
  192. END
  193.  
  194. getpal:
  195. OPEN d$ FOR BINARY AS #1
  196.  
  197. P$ = SPACE$(256 * 3): GET #1, , P$
  198. OUT &H3C7, 0: OUT &H3C8, 0
  199. FOR a = 1 TO 256 * 3: OUT &H3C9, ASC(MID$(P$, a, 1)): NEXT
  200.  
  201. CLOSE #1
  202. RETURN
  203.  
  204.  
  205.  
  206.  
  207.